home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / perl / perlvisi.1 / perlvisi / perlvision / pvbasic_u.pl < prev    next >
Encoding:
Text File  |  1995-03-22  |  6.6 KB  |  272 lines
  1. require 5.000;
  2.  
  3. # PerlVision - A class library to do ANSI graphics and textmode GUI
  4. # By Ashish Gulhati (hash@well.sf.ca.us)
  5. # V.0.1.0
  6. #
  7. # (C) Ashish Gulhati, 1995. All Rights Reserved.
  8. #
  9. # Free electronic distribution permitted. You are free to use
  10. # PerlVision in your own code so long as this copyright message stays
  11. # intact. PerlVision or derived code may not be used in any commercial
  12. # product without my prior written or PGP-signed consent. Please e-mail 
  13. # me if you make significant changes, or just want to let me know what 
  14. # you're using PerlVision for.
  15.  
  16. package pv;
  17.  
  18. sub initvision {
  19.     my $mode = shift;
  20.     system "stty", '-icanon', '-echo', '-ignbrk', '-isig', '-brkint';
  21.     $|=1;
  22.     ($mode) && (print ("\e[0;11m"));
  23.     ($mode) || (print ("\e[0;10m"));
  24.     $TL=(".","\xDA")[$mode];
  25.     $TR=(".","\xBF")[$mode];
  26.     $HZ=("-","\xC4")[$mode];
  27.     $VT=("|","\xB3")[$mode];
  28.     $BL=("`","\xC0")[$mode];
  29.     $BR=("'","\xD9")[$mode];
  30.     $LB=(" ","\xDD")[$mode];
  31.     $RB=(" ","\xDE")[$mode];
  32.     $TICK=("X","\xFB")[$mode];
  33.     $MARK=("*","\x04")[$mode];
  34.     $RS = &screen;
  35. }
  36.  
  37. sub exitvision {
  38.     system "stty sane";
  39.     print ("\e[0;10m"); 
  40.     print ("\e[?25h");
  41.     print ("\e[40;37m");
  42.     print ("\e[2J");
  43.     print ("\e[1;1H");
  44. }
  45.  
  46. sub screen {
  47.     my ($i, @qq, @xx);
  48.     for ($i=1; $i<25; $i++) {
  49.     $qq[$i] = &line;
  50.     }
  51.     for ($i=1; $i<25; $i++) {
  52.     $xx[$i] = " " x 81;
  53.     }
  54.     $i = [1,1,0,\@qq,\@xx];
  55. }
  56.  
  57. sub line {
  58.     my ($i, @qq);
  59.     my $param=shift;
  60.     for ($i=1; $i<81; $i++) {
  61.     $qq[$i] = 0;
  62.     }
  63.     $i = \@qq;
  64. }
  65.  
  66. sub pvprint {
  67.     my $input = shift;
  68.     $input=~s/\n.*//;
  69.     print $input;
  70.     my $qq=length($input);
  71.     my $i;
  72.     ($qq+$RS[1] >80) && ($qq=80-$RS[1]);
  73.     for ($i=0; $i<$qq; $i++) {
  74.     $RS[3][$RS[0]][$RS[1]+$i]=$RS[2];
  75.     }
  76.     substr($RS[4][$RS[0]],$RS[1],$qq)=substr($input,0,$qq);
  77.     $RS[1]+=$qq;
  78. }
  79.  
  80. sub refresh {
  81.     print ("\e[?25l");        
  82. }
  83.  
  84. sub redraw {
  85. }
  86.  
  87. sub pv_tellregion {
  88.     my ($x1, $y1, $x2, $y2) = @_;
  89.     my ($i, $j, $region);
  90.     my @yy=(); my @qq=(); my @xx=();
  91.     for ($i=$y1; $i<=$y2; $i++) {
  92.     for ($j=$x1; $j<=$x2; $j++) {
  93.         $qq[$i-$y1][$j-$x1]=$RS[3][$i][$j];
  94.     }
  95.     $xx[$i-$y1] = substr($RS[4][$i], $x1, $x2-$x1);
  96.     }
  97.     $region = [\@qq,\@xx];
  98.     return ($region);
  99. }
  100.  
  101. sub pv_putregion {
  102.     my ($x1, $y1, $x2, $y2, $region) = @_;
  103.     my ($i, $j, $printbuf, $back, $fore, $hi);
  104.     $printbuf="";
  105.     for ($i=$y1; $i<=$y2; $i++) {
  106.     substr($RS[4][$i], $x1, $x2-$x1) = $region->[1]->[$i-$y1];
  107.     $printbuf.="\e[$i;$x1"."H";
  108.     for ($j=$x1; $j<=$x2; $j++) {
  109.         $RS[3][$i][$j] = ${$region->[0]->[$i-$y1]}[$j-$x1];
  110.         $back = $RS[3][$i][$j] % 10;
  111.         $fore = ($RS[3][$i][$j]-$back) / 10;
  112.         $hi = ($fore > 7 ? 1 : 0);
  113.         $fore = ($fore > 7 ? $fore-8 : $fore);
  114.         $printbuf.="\e[0;$hi;3$fore;4$back"."m".substr($RS[4][$i], $j, 1);
  115.     }
  116.     }
  117.     print $printbuf;
  118. }
  119.  
  120. sub refresh_cursor {
  121.     print ("\e[$RS[0];$RS[1]"); print ("H");
  122.     print ("\e[?25h");
  123. }
  124.  
  125. sub set_cur_pos {
  126.     $RS[1]=shift;
  127.     $RS[0]=shift;
  128.     print ("\e[$RS[0];$RS[1]"); print ("H");
  129. }
  130.  
  131. sub cursor_up {
  132.     ($RS[0]>1) && ($RS[0]--);
  133.     print ("\e[A");
  134. }
  135.  
  136. sub cursor_down {
  137.     ($RS[0]<24) && ($RS[0]++);
  138.     print ("\e[B");
  139. }
  140.  
  141. sub cursor_forward {
  142.     ($RS[1]<81) && ($RS[1]++);
  143.     print ("\e[C");
  144. }
  145.  
  146. sub cursor_back {
  147.     ($RS[1]>1) && ($RS[1]--);
  148.     print ("\e[D");
  149. }
  150.  
  151. sub bgcolor {
  152.     if (($_[0] < 8) && ($_[0] >= 0)) {
  153.     $RS[2]=$RS[2]-$RS[2]%10+$_[0];
  154.     }
  155.     my $back = $RS[2] % 10;
  156.     my $fore = ($RS[2]-$back) / 10;
  157.     my $hi = ($fore > 7 ? 1 : 0);
  158.     $fore = ($fore > 7 ? $fore-8 : $fore);
  159.     print "\e[0;$hi;3$fore;4$back"."m";
  160. }
  161.  
  162. sub fgcolor {
  163.     if (($_[0] < 16) && ($_[0] >= 0)) {
  164.     $RS[2]=$RS[2]%10+($_[0]*10);
  165.     }
  166.     my $back = $RS[2] % 10;
  167.     my $fore = ($RS[2]-$back) / 10;
  168.     my $hi = ($fore > 7 ? 1 : 0);
  169.     $fore = ($fore > 7 ? $fore-8 : $fore);
  170.     print "\e[0;$hi;3$fore;4$back"."m";
  171. }
  172.  
  173. sub cls {
  174.     my ($i,$j) = (1,1);
  175.     for ($i=1;$i<25;$i++) {
  176.     for ($j=1;$j<81;$j++) {
  177.         $RS[3][$i][$j]=$RS[2];
  178.     }
  179.     $RS[4][$i]=(" " x 81);
  180.     }
  181.     print ("\e[2J");
  182. }
  183.  
  184. sub cleol {
  185.     my ($y,$x) = @RS[0..1];
  186.     substr($RS[4][$y],$x,80-$x)= (" " x (80-$x));
  187.     for ($x;$x<81;$x++) {
  188.     $RS[3][$y][$x]=$RS[2];
  189.     }
  190.     print ("\e[K");
  191. }
  192.  
  193. sub box {            # Draws your basic 3D box.
  194.     my ($x1,$y1,$x2,$y2,$style,$bgcolor)=@_;
  195.     my $lines=$x2-$x1;
  196.     my $j;
  197.     my ($TOPL,$BOTR);
  198.     if ($style) {$TOPL=15; $BOTR=0}
  199.     else {$TOPL=0; $BOTR=15}
  200.     set_cur_pos($x1,$y1); 
  201.     bgcolor ($bgcolor);
  202.     fgcolor ($TOPL);
  203.     pvprint ($TL); pvprint ($HZ x ($lines-1)); 
  204.     fgcolor ($BOTR); pvprint ($TR); 
  205.     for ($j=$y1+1; $j<$y2; $j++) {
  206.     set_cur_pos($x1,$j);
  207.     fgcolor ($TOPL); pvprint ($VT);
  208.     pvprint (" " x ($lines-1));
  209.     fgcolor ($BOTR); pvprint ($VT); 
  210.     }
  211.     set_cur_pos($x1,$y2); 
  212.     fgcolor ($TOPL); pvprint ($BL); 
  213.     fgcolor ($BOTR); pvprint ($HZ x ($lines-1));
  214.     pvprint ($BR);
  215. }
  216.  
  217. sub standard {            # Makes a standard screen (optimized)
  218.     bgcolor (6); cls; bgcolor(7);
  219.     set_cur_pos (1,1); cleol;
  220.     set_cur_pos (1,2); cleol;
  221.     set_cur_pos (1,3); cleol;
  222.     box (2,1,79,3,1,7);
  223.     box (2,4,79,24,0,6);
  224. }
  225.  
  226. sub getkey {            # Gets a keystroke and returns a code
  227.     my $key = getc;        # and the key if it's printable.
  228.     my $keycode = 0;
  229.     if ($key eq "\e") {
  230.     $key = getc;
  231.     if ($key eq "[") {    # Prolly a keypad key
  232.         $key = getc;
  233.         if ($key =~ /[A-D1-6]/) {
  234.         ($key eq "1") && (getc eq "~") && ($keycode = 1);
  235.         ($key eq "2") && (getc eq "~") && ($keycode = 2);
  236.         ($key eq "3") && (getc eq "~") && ($keycode = 3);
  237.         ($key eq "4") && (getc eq "~") && ($keycode = 4);
  238.         ($key eq "5") && (getc eq "~") && ($keycode = 5);
  239.         ($key eq "6") && (getc eq "~") && ($keycode = 6);
  240.         ($key eq "A") && ($keycode = 7);
  241.         ($key eq "B") && ($keycode = 8);
  242.         ($key eq "C") && ($keycode = 9);
  243.         ($key eq "D") && ($keycode = 10);
  244.         }
  245.     }
  246.     elsif ($key =~ /[WwBbFfIiQqVv<>DdXxHh]/) { # Meta keys
  247.         ($key =~ /[Qq]/) && ($keycode = 11);   # M-q
  248.         ($key eq "" 
  249.          || $key eq "") && ($keycode = 12);  # M-<del>
  250.         ($key =~ /[Bb]/) && ($keycode = 13);   # M-b
  251.         ($key =~ /[Dd]/) && ($keycode = 14);   # M-d
  252.         ($key =~ /[Vv]/) && ($keycode = 15);   # M-v
  253.         ($key eq "<") && ($keycode = 16);      # M-<
  254.         ($key eq ">") && ($keycode = 17);      # M->
  255.         ($key =~ /[Hh]/) && ($keycode = 18);   # M-h
  256.         ($key =~ /[Xx]/) && ($keycode = 19);   # M-x
  257.         ($key =~ /[Ff]/) && ($keycode = 20);   # M-f
  258.         ($key =~ /[Ii]/) && ($keycode = 21);   # M-i
  259.         ($key =~ /[Ww]/) && ($keycode = 22);   # M-w
  260.     }
  261.     else {
  262.         $keycode = 100;
  263.     }
  264.     }
  265.     elsif ($key =~ /[A-Za-z0-9_ \t\n\r~\`!@#\$%^&*()\-+=\\|{}[\];:'"<>,.\/?]/) {
  266.         ($keycode = 200);
  267.     }
  268.     return ($key, $keycode);
  269. }
  270.  
  271. "Perlvision. (C) Ashish Gulhati, 1995";
  272.